home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch9 / QuadMap.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-05-27  |  5.5 KB  |  194 lines

  1. VERSION 5.00
  2. Begin VB.Form frmQuadMap 
  3.    Caption         =   "QuadMap"
  4.    ClientHeight    =   4380
  5.    ClientLeft      =   60
  6.    ClientTop       =   345
  7.    ClientWidth     =   5040
  8.    LinkTopic       =   "Form1"
  9.    ScaleHeight     =   4380
  10.    ScaleWidth      =   5040
  11.    StartUpPosition =   3  'Windows Default
  12.    Begin VB.Label lblT 
  13.       BorderStyle     =   1  'Fixed Single
  14.       Height          =   255
  15.       Left            =   1440
  16.       TabIndex        =   3
  17.       Top             =   120
  18.       Width           =   495
  19.    End
  20.    Begin VB.Label lblS 
  21.       BorderStyle     =   1  'Fixed Single
  22.       Height          =   255
  23.       Left            =   360
  24.       TabIndex        =   2
  25.       Top             =   120
  26.       Width           =   495
  27.    End
  28.    Begin VB.Label Label1 
  29.       Caption         =   "T"
  30.       Height          =   255
  31.       Index           =   1
  32.       Left            =   1200
  33.       TabIndex        =   1
  34.       Top             =   120
  35.       Width           =   255
  36.    End
  37.    Begin VB.Label Label1 
  38.       Caption         =   "S"
  39.       Height          =   255
  40.       Index           =   0
  41.       Left            =   120
  42.       TabIndex        =   0
  43.       Top             =   120
  44.       Width           =   255
  45.    End
  46. Attribute VB_Name = "frmQuadMap"
  47. Attribute VB_GlobalNameSpace = False
  48. Attribute VB_Creatable = False
  49. Attribute VB_PredeclaredId = True
  50. Attribute VB_Exposed = False
  51. Option Explicit
  52. Private x1(1 To 3) As Single
  53. Private y1(1 To 3) As Single
  54. Private x2(1 To 3) As Single
  55. Private y2(1 To 3) As Single
  56. Private x3(1 To 3) As Single
  57. Private y3(1 To 3) As Single
  58. Private x4(1 To 3) As Single
  59. Private y4(1 To 3) As Single
  60. ' Using s and t values, return the coordinates of a
  61. ' point in a quadrilateral.
  62. Private Sub STToPoints(ByRef X As Single, ByRef Y As Single, ByVal s As Single, ByVal t As Single, ByVal x1 As Single, ByVal y1 As Single, ByVal x2 As Single, ByVal y2 As Single, ByVal x3 As Single, ByVal y3 As Single, ByVal x4 As Single, ByVal y4 As Single)
  63. Dim xa As Single
  64. Dim ya As Single
  65. Dim xb As Single
  66. Dim yb As Single
  67.     xa = x1 + t * (x2 - x1)
  68.     ya = y1 + t * (y2 - y1)
  69.     xb = x3 + t * (x4 - x3)
  70.     yb = y3 + t * (y4 - y3)
  71.     X = xa + s * (xb - xa)
  72.     Y = ya + s * (yb - ya)
  73. End Sub
  74. Private Sub Form_Load()
  75. Dim i As Integer
  76.     ScaleMode = vbPixels
  77.     AutoRedraw = True
  78.     x1(1) = 20
  79.     x2(1) = 120
  80.     x3(1) = 10
  81.     x4(1) = 150
  82.     y1(1) = 50
  83.     y2(1) = 30
  84.     y3(1) = 130
  85.     y4(1) = 110
  86.     x1(2) = 120
  87.     x2(2) = 210
  88.     x3(2) = 100
  89.     x4(2) = 250
  90.     y1(2) = 150
  91.     y2(2) = 170
  92.     y3(2) = 240
  93.     y4(2) = 260
  94.     x1(3) = 200
  95.     x2(3) = 300
  96.     x3(3) = 200
  97.     x4(3) = 300
  98.     y1(3) = 20
  99.     y2(3) = 20
  100.     y3(3) = 120
  101.     y4(3) = 120
  102.     For i = 1 To 3
  103.         Line (x1(i), y1(i))-(x2(i), y2(i))
  104.         Line -(x4(i), y4(i))
  105.         Line -(x3(i), y3(i))
  106.         Line -(x1(i), y1(i))
  107.     Next i
  108.     Picture = Image
  109.     DrawWidth = 3
  110. End Sub
  111. ' Find S and T for the point (X, Y) in the
  112. ' quadrilateral with points (x1, y1), (x2, y2),
  113. ' (x3, y3), and (x4, y4). Return True if the point
  114. ' lies within the quadrilateral and False otherwise.
  115. Private Function PointsToST(ByVal X As Single, ByVal Y As Single, ByRef s As Single, ByRef t As Single, ByVal x1 As Single, ByVal y1 As Single, ByVal x2 As Single, ByVal y2 As Single, ByVal x3 As Single, ByVal y3 As Single, ByVal x4 As Single, ByVal y4 As Single) As Boolean
  116. Dim Ax As Single
  117. Dim Bx As Single
  118. Dim Cx As Single
  119. Dim Dx As Single
  120. Dim Ex As Single
  121. Dim Ay As Single
  122. Dim By As Single
  123. Dim Cy As Single
  124. Dim Dy As Single
  125. Dim Ey As Single
  126. Dim a As Single
  127. Dim b As Single
  128. Dim c As Single
  129. Dim det As Single
  130. Dim denom As Single
  131.     Ax = x2 - x1: Ay = y2 - y1
  132.     Bx = x4 - x3: By = y4 - y3
  133.     Cx = x3 - x1: Cy = y3 - y1
  134.     Dx = X - x1: Dy = Y - y1
  135.     Ex = Bx - Ax: Ey = By - Ay
  136.     a = -Ax * Ey + Ay * Ex
  137.     b = Ey * Dx - Dy * Ex + Ay * Cx - Ax * Cy
  138.     c = Dx * Cy - Dy * Cx
  139.     det = b * b - 4 * a * c
  140.     If det >= 0 Then
  141.         If Abs(a) < 0.001 Then
  142.             t = -c / b
  143.         Else
  144.             t = (-b - Sqr(det)) / (2 * a)
  145.         End If
  146.         denom = (Cx + Ex * t)
  147.         If denom > 0.01 Then
  148.             s = (Dx - Ax * t) / denom
  149.         Else
  150.             s = (Dy - Ay * t) / (Cy + Ey * t)
  151.         End If
  152.         PointsToST = (t >= 0# And t <= 1# And _
  153.                   s >= 0# And s <= 1#)
  154.     Else
  155.         PointsToST = False
  156.     End If
  157. End Function
  158. Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  159. Dim i As Integer
  160. Dim j As Integer
  161. Dim s As Single
  162. Dim t As Single
  163. Dim x0 As Single
  164. Dim y0 As Single
  165.     Cls
  166.     lblS.Caption = ""
  167.     lblT.Caption = ""
  168.     ' See which quadrilateral holds the point.
  169.     For i = 1 To 3
  170.         If PointsToST(X, Y, s, t, _
  171.             x1(i), y1(i), x2(i), y2(i), _
  172.             x3(i), y3(i), x4(i), y4(i)) _
  173.         Then Exit For
  174.     Next i
  175.     If i > 3 Then
  176.         ' The point is not in any quadrilateral.
  177.         Beep
  178.     Else
  179.         PSet (X, Y)
  180.         lblS.Caption = Format$(s, "0.00")
  181.         lblT.Caption = Format$(t, "0.00")
  182.         ' Use s and t to map into the
  183.         ' other quadrilaterals.
  184.         For j = 1 To 3
  185.             If i <> j Then
  186.                 STToPoints x0, y0, s, t, _
  187.                     x1(j), y1(j), x2(j), y2(j), _
  188.                     x3(j), y3(j), x4(j), y4(j)
  189.                 PSet (x0, y0)
  190.             End If
  191.         Next j
  192.     End If
  193. End Sub
  194.